home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / NEW / A-Newest / TORPET.d64 / graphic routines (.txt) < prev    next >
Commodore BASIC  |  2009-10-12  |  6KB  |  170 lines
  1. 0 REM ***CHANGE SCREEN COLOR***
  2. 1 REM ***PRINT WAIT MESSAGE ***
  3. 2 POKE 53280,11:POKE 53281,0
  4. 4 PRINT"[152][147]CLEARING HIGH RES SCREEN . . "
  5. 6 PRINT"PLEASE WAIT 35 SECONDS"
  6. 7 PRINT"[218][216] COMMODORE-64 HI-RESOLUTION DEMO [193][211]"
  7. 8 REM *** CLEAR HI-RES SCREEN ***
  8. 10 FOR I=8192 TO 16192:POKE I,0:NEXT
  9. 13 REM *** SET UP POWERS OF 2 TABLE ***
  10. 14 REM ***    FOR ROUTINES 4 & 5    ***
  11. 16 FOR I=0 TO 7:P(I)=2^(7-I):P1(I)=255-P(I):NEXT
  12. 17 REM ***   START HI-RES MODE AND   ***
  13. 18 REM *** SET HI-RES SCREEN AT 8192 ***
  14. 20 PRINT"[147]":POKE 53265,PEEK(53265)OR32:POKE 53272,PEEK(53272)OR8
  15. 25 REM ***    SET HI-RES COLORS    ***
  16. 26 REM ***UPPER NYBBLE FOR "1" BITS***
  17. 27 REM ***LOWER NYBBLE FOR "0" BITS***
  18. 30 FOR I=1024 TO 2023:POKE I,192:NEXT
  19. 100 REM ***PRINT STRINGS USING***
  20. 101 REM ***     ROUTINE 1     ***
  21. 102 L=0:R=0:X=0:Y=13:B1=53248:O=1:B$="-2[255][157][157][145][157][199]":GOSUB 10000
  22. 103 X=20:Y=13:B$="0":GOSUB 10000
  23. 104 X=37:Y=13:B$="[145][217][157][157][157]+2[255]":GOSUB 10000
  24. 105 X=19:Y=3:B$="[198]+1":GOSUB 10000
  25. 106 X=19:Y=21:B$="[196]-1":GOSUB 10000
  26. 107 R=1:X=1:Y=23:B$="[218][216] COMMODORE-64 [200]I-[210]ESOLUTION [196]EMO [142][193][211]":GOSUB 10000
  27. 108 REM *** PRINT AXIS USING ***
  28. 109 REM ***    ROUTINE 3     ***
  29. 110 X1=0:Y1=100:X2=319:Y2=100:GOSUB 30000
  30. 113 REM *** PRINT AXIS USING ***
  31. 114 REM ***    ROUTINE 4     ***
  32. 115 FOR Y=25 TO 174:X=158:GOSUB 1000:X=157:GOSUB 1000:NEXT
  33. 116 REM *** GET USER INPUT WITH ***
  34. 117 REM ***      ROUTINE 2      ***
  35. 120 BL=1:X=0:Y=0:R=0:B$="INPUT PERIOD ? ":GOSUB 20000:J=VAL(I$)
  36. 125 REM *** PLOT SINE CURVE ***
  37. 126 REM *** USING ROUTINE 4 ***
  38. 130 FOR X=0 TO 319:Z=SIN((X-158)/25*J):Y=INT(100-70*Z*Z*Z):GOSUB 1000:NEXT
  39. 131 REM *** LABEL PLOT WITH INPUT ***
  40. 132 REM ***    USING ROUTINE 1    ***
  41. 133 L=1:R=0:X=4:Y=1:B$="Y=[142]SIN[145]3(":GOSUB 10000
  42. 134 B$=I$:GOSUB 10000:B$="*X)":GOSUB 10000
  43. 137 REM *** PAUSE LOOP: WHEN "A"  ***
  44. 138 REM *** IS RECEIVED GO BACK   ***
  45. 139 REM ***   TO STANDARD MODE    ***
  46. 140 REM ***      AND STOP         ***
  47. 145 GET A$:IF A$="" THEN 145
  48. 150 POKE 53265,PEEK(53265)AND223:PRINT"[147]";:POKE 53272,PEEK(53272)AND21:END
  49. 982 :
  50. 984 :
  51. 990 REM ***     ROUTINES 4 & 5    ***
  52. 992 REM ***    FOR PLOTTING AND   ***
  53. 994 REM ***   UNPLOTTING POINTS   ***
  54. 996 REM *** SEE REF. GUIDE PG 125 ***
  55. 997 :
  56. 1000 B=INT(Y/8)*320+INT(X/8)*8+(YAND7)+8192:POKE B,PEEK(B)ORP(XAND7):RETURN
  57. 1001 B=INT(Y/8)*320+INT(X/8)*8+(YAND7)+8192:POKE B,PEEK(B)ANDP1(XAND7):RETURN
  58. 9980 :
  59. 9982 :
  60. 9990 REM *** ROUTINE 1: FOR PRINTING ***
  61. 9992 REM ***   STRINGS IN HI- RES    ***
  62. 9993 :
  63. 9994 REM *** DISABLE INTERRUPTS & ***
  64. 9996 REM ***  SWITCH IN CHAR ROM  ***
  65. 9998 REM *** CALCULATE CHAR BASE  ***
  66. 10000 POKE 56334,PEEK(56334)AND254:POKE 1,PEEK(1)AND251:B2=B1+R*1024+L*2048
  67. 10010 REM ***  GET A CHARACTER  ***
  68. 10012 REM *** FROM INPUT STRING ***
  69. 10020 FOR I=1 TO LEN(B$):C=ASC(MID$(B$,I,1))
  70. 10026 REM *** SPECIAL CHARACTERS ***
  71. 10028 REM ***  DECODING SECTION  ***
  72. 10030 IF C=145 THEN Y=Y-1:NEXT:RETURN:REM ** CURSOR UP **
  73. 10040 IF C=17 THEN Y=Y+1:NEXT:RETURN:REM ** CURSOR DOWN **
  74. 10050 IF C=29 THEN X=X+1:NEXT:RETURN:REM ** CURSOR RIGHT **
  75. 10060 IF C=157 THEN X=X-1:NEXT:RETURN:REM ** CURSOR LEFT **
  76. 10070 IF C=18 THEN R=1:B2=B1+1024+L*2048:NEXT:RETURN:REM ** REVERSE ON **
  77. 10080 IF C=146 THEN R=0:B2=B1+L*2048:NEXT:RETURN:REM ** REVERSE OFF **
  78. 10090 IF C=19 THEN X=0:Y=0:NEXT:RETURN:REM ** CURSOR HOME **
  79. 10100 IF C=14 THEN L=1:B2=B1+R*1024+2048:NEXT:RETURN:REM ** START LOWER CASE **
  80. 10120 IF C=142 THEN L=0:B2=B1+R*1024:NEXT:RETURN:REM ** STOP LOWER CASE **
  81. 10130 IF C=255 THEN C=126:REM ** "[255]" IS SPECIAL CASE **
  82. 10132 REM ***  TRANSLATE CHR$ CODES  ***
  83. 10134 REM *** TO SCREEN CODES: CHARS ***
  84. 10136 REM *** PATTERNS IN ROM STORED ***
  85. 10138 REM ***    BY SCREEN CODE      ***
  86. 10140 ON C/32+1 GOTO 10150,10200,10170,10160,10150,10170,10190,10170
  87. 10150 C=32:GOTO 10200
  88. 10160 C=C-32:GOTO 10200
  89. 10170 C=C-64:GOTO 10200
  90. 10180 C=C-96:GOTO 10200
  91. 10190 C=C-128
  92. 10192 REM *** CALCULATE STARTING POS ***
  93. 10194 REM ***   FOR STRING AND CHAR  ***
  94. 10196 REM ***       DEFINITION       ***
  95. 10200 Z=Y*320+X*8+8192:C=C*8+B2
  96. 10220 REM *** POKE DEFINITION INTO ***
  97. 10222 REM ***   HI-RES LOCATION    ***
  98. 10240 FOR J=0 TO 7:POKE Z+J,(O*PEEK(Z+J))ORPEEK(C+J):NEXT:X=X+1:NEXT
  99. 10260 REM *** RE-ENABLE INTERRUPTS ***
  100. 10262 REM ***  AND SWITCH OUT ROM  ***
  101. 10290 POKE 1,PEEK(1)OR4:POKE 56334,PEEK(56334)OR1:RETURN
  102. 19880 :
  103. 19882 :
  104. 19900 REM *** ROUTINE 2-USER INPUT    ***
  105. 19901 :
  106. 19902 REM *** INITIALIZE INPUT STRING ***
  107. 19904 REM *** SAVE START POSITION AND ***
  108. 19906 REM ***    LENGTH OF PROMPT     ***
  109. 20000 I$="":HX=X:HY=Y:HB=LEN(B$):GOSUB 10000
  110. 20008 REM *** GET A CHAR ***
  111. 20010 GET B$:IF B$="" THEN 20010
  112. 20014 REM *** CHECK FOR SPECIAL CHARS ***
  113. 20016 REM ***    ONLY FIRST TWO ARE   ***
  114. 20018 REM ***DIFFERENT FROM ROUTINE 1 ***
  115. 20020 IF B$=CHR$(13) THEN 20070:REM *** RETURN ***
  116. 20030 IF B$=CHR$(20) THEN 20045:REM *** DELETE ***
  117. 20031 IF B$=CHR$(145) THEN 20041
  118. 20032 IF B$=CHR$(17) THEN 20041
  119. 20033 IF B$=CHR$(29) THEN 20041
  120. 20034 IF B$=CHR$(157) THEN 20041
  121. 20035 IF B$=CHR$(18) THEN 20041
  122. 20036 IF B$=CHR$(146) THEN 20041
  123. 20037 IF B$=CHR$(19) THEN 20041
  124. 20038 IF B$=CHR$(14) THEN 20041
  125. 20039 IF B$=CHR$(142) THEN 20041
  126. 20040 REM *** ECHO CHARACTER ***
  127. 20041 GOSUB 10000
  128. 20042 I$=I$+B$:GOTO 20010
  129. 20043 REM *** DELETE KEY: DONT DELETE ***
  130. 20044 REM ***    IF NOTHING THERE     ***
  131. 20045 IF LEN(I$)=0 THEN 20010
  132. 20046 REM *** MOVE BACK AND BLANK ONE ***
  133. 20047 REM ***    CHAR; UPDATE INPUT   ***
  134. 20050 X=X-1:Z=Y*320+X*8+8192:FOR I=0 TO 7:POKE Z+I,0:NEXT:I$=LEFT$(I$,LEN(I$)-1)
  135. 20058 REM *** GET NEXT CHAR ***
  136. 20060 GOTO 20010
  137. 20066 REM *** BLANK INPUT IF DESIRED ***
  138. 20068 REM ***      ELSE RETURN       ***
  139. 20070 IF BL=0 THEN RETURN
  140. 20074 REM *** STARTING ADDRESS FOR  ***
  141. 20076 REM *** BLANKING AND BLANKING ***
  142. 20078 REM ***         LOOP          ***
  143. 20080 Z=320*HY+8*HX+8192:FOR I=0 TO (HB+LEN(I$))*8:POKE Z+I,0:NEXT:RETURN
  144. 29880 :
  145. 29882 :
  146. 29900 REM ***  ROUTINE 3    ***
  147. 29902 REM *** DRAW A LINE   ***
  148. 29903 :
  149. 29904 REM ***  CALCULATE SLOPE AND  ***
  150. 29906 REM ***   DECIDE WHETHER TO   ***
  151. 29908 REM ***    INCREMENT X OR Y   ***
  152. 30000 XD=X1-X2:YD=Y1-Y2
  153. 30010 IFXD=0THEN30200
  154. 30020 IFYD=0THEN30300
  155. 30030 M=YD/XD:S=Y1-M*X1
  156. 30040 IFABS(M)<=.5THEN30400
  157. 30050 M=XD/YD:S=X1-M*Y1
  158. 30060 REM *** CALCULATE X  ***
  159. 30062 REM *** STEP ALONG Y ***
  160. 30100 FORY=Y1TOY2STEPSGN(Y2-Y1):X=M*Y+S:GOSUB1000:NEXT:RETURN
  161. 30160 REM *** VERTICAL LINE ***
  162. 30162 REM ***  STEP ALONG Y ***
  163. 30200 X=X1:FORY=Y1TOY2STEPSGN(Y2-Y1):GOSUB1000:NEXT:RETURN
  164. 30260 REM *** HORIZONTAL LINE ***
  165. 30262 REM ***   STEP ALONG X  ***
  166. 30300 Y=Y1:FORX=X1TOX2STEPSGN(X2-X1):GOSUB1000:NEXT:RETURN
  167. 30360 REM *** CALCULATE Y  ***
  168. 30362 REM *** STEP ALONG X ***
  169. 30400 FORX=X1TOX2STEPSGN(X2-X1):Y=M*X+S:GOSUB1000:NEXT:RETURN
  170.